home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / util / cli / fdb2.lha / FDB2 / FDB2.mod < prev    next >
Text File  |  1995-04-20  |  10KB  |  415 lines
  1. MODULE FDB2;
  2.  
  3. (*
  4.     FDB2 by Carsten Orthbandt
  5.     Version 1.3  20/04/95
  6.     The better FindDB.
  7.  
  8.     This is free software und the GNU License.
  9.     See the file COPYING for copying permission.
  10. *)
  11.  
  12. IMPORT
  13.       d:Dos,
  14.       Arguments,
  15.       y:SYSTEM,
  16.       fs:FileSystem,
  17.       u:Utility,
  18.       str:Strings,
  19.       Break,
  20.       io;
  21.  
  22. CONST
  23.       template=
  24.        "P=PATTERN/A,DBD=DBASEDIR/K,MPATH/K,E=EXACT/S,CS=CASESENSITIVE/S,"
  25.        "D=DIRS/S,F=FILES/S,O=ONCE/S,ALLDBS/S,NH=NOHEAD/S,"
  26.        "NP=NOPATH/S,PG=PAGES/S,NOINFO/S,SETENV/S,DB=DATABASE/K"
  27.        "\o$VER: FDB2 1.3 by HDS 20/04/95\o";
  28.  
  29.       VersionComment=
  30.        "\nFDB2 1.3 by HDS\n"
  31.      "The better FindDB.\nThis is Freeware under GNU License. See docs for details.\n\n";
  32.  
  33.       HelpText=
  34.      "\nP=PATTERN/A       : Dos pattern to search for.\n"
  35.        "DBD=DBASEDIR/K    : Dir to search for databases. Default is DEVS:.\n"
  36.        "MPATH/K           : Ignore entry if this path doesn´t match.\n"
  37.        "E=EXACT/S         : Show only exact matches of pattern.\n"
  38.        "CS=CASESENSITIVE/S: Search case sensitive.\n"
  39.        "D=DIRS/S          : Show only dirs.\n"
  40.        "F=FILES/S         : Show only files.\n"
  41.        "O=ONCE/S          : Show only first match.\n"
  42.        "ALLDBS/S          : Scan all databases in database dir. Overrides DATABASE.\n"
  43.        "NH=NOHEAD/S       : Don´t show header.\n"
  44.        "NP=NOPATH/S       : Don´t show paths.\n"
  45.        "PG=PAGES/S        : Not used. Compatibility only.\n"
  46.        "NOINFO/S          : Ignore .info files.\n"
  47.        "SETENV/S          : Store this command line as default in ENV:FDB2.prefs.\n"
  48.        "DB=DATABASE/K     : FDB Database to use. Default is find.codes.\n"
  49.        "Enter arguments";
  50.  
  51. TYPE
  52.   strg=ARRAY 300 OF CHAR;
  53.  
  54.   Args = STRUCT (as :d.ArgsStruct);
  55.            pttrn    :d.ArgString;
  56.            dbdir    :d.ArgString;
  57.            mpath    :d.ArgString;
  58.            exact    :d.ArgBool;
  59.            cases    :d.ArgBool;
  60.            dirs     :d.ArgBool;
  61.            files    :d.ArgBool;
  62.            once     :d.ArgBool;
  63.            alldb    :d.ArgBool;
  64.            nohead   :d.ArgBool;
  65.            nopath   :d.ArgBool;
  66.            pages    :d.ArgBool;
  67.            noinfo   :d.ArgBool;
  68.            setenv   :d.ArgBool;
  69.            dbase    :d.ArgString;
  70.          END;
  71.  
  72. TYPE
  73.        dbsPtr=POINTER TO dbs;
  74.        dbs   =STRUCT
  75.               next:dbsPtr;
  76.               name:strg;
  77.               END;
  78.  
  79. TYPE
  80.        EntryPtr=POINTER TO Entry;
  81.        Entry   = STRUCT
  82.                next:EntryPtr;
  83.                name:strg;
  84.                END;
  85.  
  86.  
  87. VAR
  88.        tmps,rpatt,mpath,mpatt,patt,dbase,olin,line,dir,search,dbdir:strg;
  89.        fi:fs.File;
  90.        i,j,start: LONGINT;
  91.        nm,nma,len,len2:LONGINT;
  92.        noinfo,alldb,setenv,nohead,nopath,files,dirs,case,exct,once,done:BOOLEAN;
  93.        dbases:dbsPtr;
  94.        dummy:BOOLEAN;
  95.        ed,ef,ad,af,bd,bf:EntryPtr;
  96.  
  97. PROCEDURE Scan(Name:ARRAY OF CHAR);
  98. VAR  Fi:d.FileInfoBlockPtr;
  99.      Cd:d.FileLockPtr;
  100.      S:ARRAY 256 OF CHAR;
  101.      S1,S2,S3:BOOLEAN;
  102.      ndbs:dbsPtr;
  103. BEGIN;
  104. NEW(Fi);
  105. Cd:=d.Lock(Name,d.sharedLock);
  106. S1:=d.Examine(Cd,Fi^);
  107. IF S1 THEN
  108.   REPEAT;
  109.     S2:=d.ExNext(Cd,Fi^);
  110.     IF S2 THEN
  111.       IF (Fi.dirEntryType<0) THEN
  112.        IF str.Occurs(Fi.fileName,".codes")#-1 THEN
  113.         NEW(ndbs);
  114.         ndbs.next:=dbases;
  115.         COPY(Fi.fileName,ndbs.name);
  116.         dbases:=ndbs;
  117.        END;
  118.       END;
  119.     END;
  120.   UNTIL ~S2;
  121. END;
  122. d.UnLock(Cd);
  123. DISPOSE(Fi);
  124. END Scan;
  125.  
  126. PROCEDURE ReadArgs;
  127. VAR
  128.       cmargs:d.RDArgsPtr;
  129.       cmargv:Args;
  130.       envar:d.RDArgsPtr;
  131. PROCEDURE ParseArgs;
  132. BEGIN;
  133.   COPY(cmargv.pttrn^,patt);
  134.   IF cmargv.dbase#NIL THEN COPY(cmargv.dbase^,dbase);END;
  135.   IF cmargv.dbdir#NIL THEN COPY(cmargv.dbdir^,dbdir);END;
  136.   IF cmargv.mpath#NIL THEN COPY(cmargv.mpath^,mpath);END;
  137.   exct:=(cmargv.exact)#0;
  138.   case:=(cmargv.cases)#0;
  139.   once:=(cmargv.once)#0;
  140.   alldb:=(cmargv.alldb)#0;
  141.   dirs:=(cmargv.dirs)#0;
  142.   files:=(cmargv.files)#0;
  143.   nohead:=(cmargv.nohead)#0;
  144.   nopath:=(cmargv.nopath)#0;
  145.   noinfo:=(cmargv.noinfo)#0;
  146.   setenv:=(cmargv.setenv)#0;
  147. END ParseArgs;
  148.  
  149. PROCEDURE MakeEnvString;
  150. VAR st1:strg;
  151.     n:INTEGER;
  152.     m:LONGINT;
  153.     fl:fs.File;
  154. BEGIN;
  155. IF fs.Open(fl,"ENV:FDB2.prefs",TRUE) THEN
  156.  FOR n:=1 TO Arguments.NumArgs() DO
  157.   Arguments.GetArg(n,st1);
  158.   FOR m:=0 TO str.Length(st1)-1 DO
  159.    IF fs.WriteChar(fl,st1[m]) THEN END;
  160.   END;
  161.   IF fs.WriteChar(fl," ") THEN END;
  162.  END;
  163.   IF fs.WriteChar(fl,"\n") THEN END;
  164.  IF fs.Close(fl) THEN END;
  165.  END;
  166. END MakeEnvString;
  167.  
  168. PROCEDURE Defaults;
  169. BEGIN;
  170.   cmargv.dbase:=y.ADR("find");
  171.   cmargv.dbdir:=y.ADR("DEVS:");
  172.   cmargv.mpath:=y.ADR("#?");
  173.   cmargv.dirs:=0;
  174.   cmargv.files:=0;
  175.   cmargv.cases:=0;
  176.   cmargv.exact:=0;
  177.   cmargv.once:=0;
  178.   cmargv.alldb:=0;
  179.   cmargv.nohead:=0;
  180.   cmargv.nopath:=0;
  181.   cmargv.pages:=0;
  182.   cmargv.noinfo:=0;
  183.   cmargv.setenv:=0;
  184. END Defaults;
  185.  
  186. PROCEDURE UpdateDefaults;
  187. BEGIN;
  188.   cmargv.dbase:=y.ADR(dbase);
  189.   cmargv.dbdir:=y.ADR(dbdir);
  190.   cmargv.mpath:=y.ADR(mpath);
  191.  IF dirs THEN cmargv.dirs:=1;END;
  192.  IF files THEN cmargv.files:=1;END;
  193.  IF case THEN cmargv.cases:=1;END;
  194.  IF exct THEN cmargv.exact:=1;END;
  195.  IF once THEN cmargv.once:=1;END;
  196.  IF alldb THEN cmargv.alldb:=1;END;
  197.  IF nohead THEN cmargv.nohead:=1;END;
  198.  IF nopath THEN cmargv.nopath:=1;END;
  199.  IF noinfo THEN cmargv.noinfo:=1;END;
  200.  cmargv.setenv:=0;
  201. END UpdateDefaults;
  202.  
  203. PROCEDURE ReadPrefs;
  204. VAR fl:fs.File;
  205.     st1,st2,st3:strg;
  206.     n:LONGINT;
  207. BEGIN;
  208. IF fs.Open(fl,"ENV:FDB2.prefs",FALSE) THEN
  209.  IF fs.ReadString(fl,st1) THEN
  210.   st1[str.Length(st1)]:="\n";
  211.   envar:=d.AllocDosObjectTags(d.rdArgs,u.done);
  212.   envar.extHelp:=y.ADR(HelpText);
  213.   envar.source.buffer:=y.ADR(st1);
  214.   envar.source.length:=str.Length(st1);
  215.   envar.source.curChr:=0;
  216.   cmargs := d.ReadArgs(template, cmargv, envar);
  217.   IF cmargs=NIL THEN
  218.     IF d.PrintFault(d.IoErr(),"FDB2 Invalid Prefs") THEN END;
  219.   ELSE
  220.   ParseArgs;
  221.   UpdateDefaults;
  222.   d.FreeArgs(cmargs);
  223.   END;
  224.   d.FreeDosObject(d.rdArgs,envar);
  225.  END;
  226.  IF fs.Close(fl) THEN END;
  227. END;
  228. END ReadPrefs;
  229.  
  230. BEGIN;
  231.   IF Arguments.NumArgs()>0 THEN
  232.    Arguments.GetArg(1,dbase);
  233.    IF dbase="?" THEN io.WriteString(VersionComment);END;
  234.   END;
  235.   Defaults;
  236.   ReadPrefs;
  237.   setenv:=FALSE;
  238.   cmargv.setenv:=0;
  239.   envar:=d.AllocDosObjectTags(d.rdArgs,u.done);
  240.   envar.extHelp:=y.ADR(HelpText);
  241.   cmargs := d.ReadArgs(template, cmargv, envar);
  242.   IF cmargs=NIL THEN
  243.     IF d.PrintFault(d.IoErr(),"FDB2") THEN END;
  244.     HALT(20)
  245.   END;
  246.   ParseArgs;
  247.   d.FreeArgs(cmargs);
  248.   d.FreeDosObject(d.rdArgs,envar);
  249.   IF setenv THEN MakeEnvString;END;
  250.   IF ~dirs AND ~files THEN dirs:=TRUE;files:=TRUE;END;
  251. END ReadArgs;
  252.  
  253. PROCEDURE GetDBName(db:strg):strg;
  254. VAR ret:strg;
  255. BEGIN;
  256.  ret:=dbdir;
  257.  IF d.AddPart(ret,db,300) THEN END;
  258.  RETURN ret;
  259. END GetDBName;
  260.  
  261. PROCEDURE AnsiDir;
  262. BEGIN;
  263. io.WriteString("\2331m");
  264. END AnsiDir;
  265.  
  266. PROCEDURE AnsiHead;
  267. BEGIN
  268. io.WriteString("\2332m");
  269. END AnsiHead;
  270.  
  271. PROCEDURE AnsiOff;
  272. BEGIN;
  273. io.WriteString("\2330m");
  274. END AnsiOff;
  275.  
  276. PROCEDURE ShowDate(name:ARRAY OF CHAR);
  277. VAR dt:d.DateTime;
  278.     lck:d.FileLockPtr;
  279.     fb:d.FileInfoBlockPtr;
  280.     outp:ARRAY 30 OF CHAR;
  281. BEGIN;
  282.  NEW(fb);
  283.  lck:=d.Lock(name,d.sharedLock);
  284.  IF lck#NIL THEN
  285.   IF d.Examine(lck,fb^) THEN
  286.    dt.format:=0;
  287.    dt.flags:=SHORTSET{0};
  288.    dt.stamp:=fb.date;
  289.    dt.strDate:=y.ADR(outp);
  290.    dt.strDay:=NIL;
  291.    dt.strTime:=NIL;
  292.    IF d.DateToStr(dt) THEN io.WriteString(outp);END;
  293.   END;
  294.   d.UnLock(lck);
  295.  END;
  296. DISPOSE(fb);
  297. END ShowDate;
  298.  
  299. PROCEDURE PrintLists;
  300. BEGIN;
  301.  io.WriteString("Dirs:");
  302.  ad:=ed;
  303.  WHILE ad#NIL DO
  304.   io.WriteString(ad.name);io.WriteLn;
  305.   bd:=ad;ad:=ad.next;DISPOSE(bd);
  306.  END;
  307.  io.WriteString("\nFiles:");
  308.  af:=ef;
  309.  WHILE af#NIL DO
  310.   io.WriteString(af.name);io.WriteLn;
  311.   bf:=af;af:=af.next;DISPOSE(bf);
  312.  END;
  313. END PrintLists;
  314.  
  315. PROCEDURE FinderNoCase;
  316. BEGIN;
  317. NEW(ed);NEW(ef);
  318. ed.name:="";ef.name:="";
  319. bd:=ed;bf:=ef;
  320. len2:=str.Length(search);
  321. IF fs.Open(fi,GetDBName(dbase),FALSE) THEN
  322.  WHILE fs.ReadString(fi,line)AND ~done DO
  323.   olin:=line;
  324.   IF ~case THEN str.Upper(olin);END;
  325.   len:=str.Length(line);
  326.    IF line[len-1]="/" THEN
  327.     dir:=line;
  328.     IF d.MatchPattern(mpatt,dir) THEN
  329.     IF d.MatchPattern(search,olin)AND dirs THEN
  330.      done:=once;
  331.      NEW(ad);ad.name:=dir;bd.next:=ad;bd:=ad;
  332.     END;
  333.     END;
  334.    ELSE
  335.     IF d.MatchPattern(mpatt,dir) THEN
  336.     IF d.MatchPattern(search,olin)AND files THEN
  337.      done:=once;
  338.      IF (~noinfo) OR (str.Occurs(line,".info")=-1) THEN
  339.       NEW(af);af.name:="";bf.next:=af;bf:=af;
  340.       IF ~nopath THEN af.name:=dir;END;
  341.       str.Append(af.name,line);
  342.      ELSE
  343.       done:=FALSE;
  344.      END;
  345.     END;
  346.     END;
  347.    END;
  348.  END;
  349.  IF fs.Close(fi) THEN END;
  350.  PrintLists;
  351. ELSE
  352.  io.WriteString("Could not open ");io.WriteString(dbase);io.WriteLn;
  353. END;
  354. END FinderNoCase;
  355.  
  356. PROCEDURE SearchDB;
  357. BEGIN;
  358.  done:=FALSE;
  359.  i:=str.Length(dbase);
  360.  IF str.Occurs(dbase,".codes")=-1 THEN
  361.  str.Append(dbase,".codes");
  362.  END;
  363.  IF ~nohead THEN
  364.     io.WriteString(" >> Searching ");io.WriteString(dbase);
  365.     io.WriteString(" for ");io.WriteString(patt);io.WriteString("  ( ");
  366.     ShowDate(GetDBName(dbase));io.WriteString(")\n");
  367.  END;
  368.  IF ~case THEN
  369.   str.Upper(patt);
  370.  END;
  371.  IF ~exct THEN
  372.   search:=patt;
  373.   patt[0]:="#";
  374.   patt[1]:="?";
  375.   i:=0;
  376.   WHILE search[i]#CHR(0) DO
  377.    patt[i+2]:=search[i];INC(i);
  378.   END;
  379.   patt[i+2]:="#";
  380.   patt[i+3]:="?";
  381.   patt[i+4]:=CHR(0);
  382.  END;
  383.  IF d.ParsePattern(mpath,mpatt,300)#-1 THEN
  384.  IF d.ParsePattern(patt,search,300)#-1 THEN
  385.   FinderNoCase;
  386.  END;END;
  387. END SearchDB;
  388.  
  389. PROCEDURE Main;
  390. VAR adb,odb:dbsPtr;
  391. BEGIN;
  392.  IF ~alldb THEN
  393.  NEW(dbases);
  394.  dbases.next:=NIL;
  395.  dbases.name:=dbase;
  396.  ELSE
  397.  Scan(dbdir);
  398.  END;
  399.  rpatt:=patt;
  400.  adb:=dbases;
  401.  WHILE adb#NIL DO
  402.   dbase:=adb.name;
  403.   SearchDB;
  404.   patt:=rpatt;
  405.   adb:=adb.next;
  406.  END;
  407. END Main;
  408.  
  409.  
  410. BEGIN;
  411.  ReadArgs;
  412.  Main;
  413. END FDB2.
  414.  
  415.